perm filename MEM[CRE,BGB]1 blob
sn#020176 filedate 1973-01-17 generic text, type T, neo UTF8
00100 ;-----------------------------------------------------------------
00200 INTERN OLD44,FILM,BLKCNT,AVAIL
00300 OLD44: 0
00400 FILM: 0
00500 BLKCNT: 0
00600 AVAIL: 0
00700 REMAINDER:0
00800 NODSIZ←←7
00900 SUBR(MORCOR)------------------------------------------------------
01000 BEGIN MORCOR; - GET MORE CORE - BGB - 4 DEC 1972.
01100
01200 ;INITIALIZE FILM BLOCK POINTERS WHEN NECESSARY.
01300 SKIPE OLD44↔GO L1
01400 LAC 1,44↔DAC 1,OLD44
01500 AOS 1↔DAC 1,FILM
01600 ADDI 1,3↔DAC 1,AVAIL
01700 AOS 1↔DAC 1,BLKCNT
01800 SETZM REMAINDER
01900
02000 ;FOUR MORE K !
02100 L1: LAC 1,44↔LAC 0,1↔ADDI 0,10000
02200 CALLI 11↔GO[FATAL(NO MORE CORE.)]
02300 AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
02400 SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
02500
02600 ;MAKE AVAIL LIST.
02700 DIP 1,1↔ADD 1,[XWD NODSIZ,0]
02800 SKIPE@BLKCNT↔GO .+3
02900 ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@BLKCNT
03000 DAPZ 1,@AVAIL
03100 L2: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
03200 CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
03300 SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03400 LACI 10000↔ADDM @FILM
03500 LAC 1,FILM↔LAC[FILBIT+010000]↔DAC(1)
03600 LAC 1,@AVAIL
03700 LAC 2,AC2↔POP0J
03800 BEND;12/16/72-----------------------------------------------------
00100 SUBR(MAKE)TYPE,,RELOC---------------------------------------------
00200 BEGIN MAKE; ALLOCATE A NODSIZ BLOCK OF WORDS - BGB - 4 DEC 1972.
00300 SKIPN 1,@AVAIL
00400 CALL(MORCOR)
00500 CDR(1)↔DAP @AVAIL
00600 SETZM(1)↔AOS @BLKCNT
00700 POP P,.+3↔POP P,2(1)↔GO @.+1↔0
00800 POP1J
00900 BEND;1/10/73------------------------------------------------------
01000
01100 SUBR(KILL)NODE----------------------------------------------------
01200 BEGIN KILL; - RELEASE A NODSIZ BLOCK OF WORDS - BGB - 4 DEC 1972.
01300 LAC 1,ARG1
01400 SKIPN 2(1)↔GO[OUTSTR[ASCIZ/ EMPTY NODE KILLED.
01500 /]↔POP1J]↔SOS @BLKCNT
01600 SETZM(1)↔LIPI(1)↔LAPI 1(1)↔BLT NODSIZ-1(1)
01700 LAC @AVAIL↔DAPZ(1)↔DAPZ 1,@AVAIL
01800 POP1J
01900 BEND;12/17/72-----------------------------------------------------
02000
02100 SUBR(RINGIN)------------------------------------------------------
02200 BEGIN RINGIN;(PART,WHOLE) RING PART INTO A WHOLE -BGB- 6 DEC 1972.
02300 LAC 1,ARG2
02400 LAC 3,ARG1
02500 SON 2,3
02600 JUMPE 2,[SON. 1,3↔DIP 1,(1)↔DAP 1,(1)↔POP2J]
02700 CAR 3,(2)
02800 DIP 3,(1)↔DAP 1,(3)
02900 DAP 2,(1)↔DIP 1,(2)
03000 POP2J↔LIT
03100 BEND;1/10/73------------------------------------------------------
00100 SUBR(SHRINK)------------------------------------------------------
00200 BEGIN SHRINK;SHRINK NODE SPACE - BGB - 17 JANUARY 1973.
00300 ACCUMULATORS{A,HOLE,BREAK,NODE}
00400 LAC@BLKCNT↔IMULI NODSIZ↔ADD FILM
00500 DAC BREAK↔LACI NODE,-NODSIZ(BREAK)↔SKIPA HOLE,FILM
00600
00700 ;FIND A HOLE BELOW THE BREAK.
00800 L1: ADDI HOLE,NODSIZ↔CAML HOLE,BREAK↔GO L3
00900 TYPE 0,HOLE↔JUMPN 0,L1
01000
01100 ;FIND A NODE ABOVE THE BREAK.
01200 L2: ADDI NODE,NODSIZ
01300 CAML NODE,44↔GO[FATAL({SHRINK - NODE CNT TOO BIG.})]
01400 TYPE 0,NODE↔JUMPE 0,L2
01500
01600 ;MOVE THE NODE INTO THE HOLE.
01700 DIP NODE,0↔DAP HOLE,0
01800 BLT 0,NODSIZ-1(HOLE)
01900 DAPZ HOLE,0(NODE) ;NODE'S NEW LOCATION.
02000 GO L1
02100
00100 ;REPLACE LINKS ABOVE THE BREAK WITH THEIR NEW VALUES.
00200 DEFINE KAR(Q){
00300 CAR 1,Q(A)
00400 CAML 1,BREAK↔LAC 1,0(1)
00500 DIP 1,Q(A)↔GO .+1}
00600 DEFINE KDR(Q){
00700 CDR 1,Q(A)
00800 CAML 1,BREAK↔LAC 1,0(1)
00900 DAP 1,Q(A)↔GO .+1}
01000
01100 L3: LAC A,FILM ;BLOCK POINTER.
01200 L4: RELOC 0,A↔TRNE 400000↔LACI 333333
01300 TRNE 200000↔GO[KAR 0]↔ TRNE 100000↔GO[KDR 0]
01400 TRNE 20000 ↔GO[KAR 1]↔ TRNE 10000 ↔GO[KDR 1]
01500 TRNE 2000 ↔GO[KAR 3]↔ TRNE 1000 ↔GO[KDR 3]
01600 TRNE 200 ↔GO[KAR 4]↔ TRNE 100 ↔GO[KDR 4]
01700 TRNE 20 ↔GO[KAR 5]↔ TRNE 10 ↔GO[KDR 5]
01800 TRNE 2 ↔GO[KAR 6]↔ TRNE 1 ↔GO[KDR 6]
01900 ADDI A,NODSIZ↔CAMGE A,BREAK↔GO L4
02000
02100 ;SHRINK CORE SIZE AND RESET AVAIL LIST.
02200 LAC 0,BREAK↔IORI 0,1777↔CALLI 0,11↔HALT ;SHRINK CORE.
02300 LAC 1,BREAK↔LAC 2,44↔DAPZ 1,@AVAIL ;NEW BOUNDS.
02400 LACI 0,1(1)↔DIP 1,0↔SETZM(1)↔BLT(2) ;CLEAR AVAILS.
02500 LACI 1(2)↔SUB FILM↔DAC@FILM ;NEW CORE SIZE.
02600
02700 LIPI 1,NODSIZ(1)↔GO L6
02800 L5: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
02900 L6: CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
03000 SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER↔POP0J
03100
03200 LIT
03300 BEND;1/17/73------------------------------------------------------